perm filename PCHK[S1,ALS]4 blob sn#450340 filedate 1979-06-18 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(*New var's needed in *)
C00006 ENDMK
CāŠ—;
(*New var's needed in *)
NWORDS_OLD : 0..MAXCODEW;
NEWINSTREC_OLD : A_CODEREC;
OPC_OLD : U_OPCODE;

OPC_OLD := OPC;  (* PUT THIS IN READNXTINST AFTER begin*)
READINT (I1) ;   (*THIS GOES INTO UCHKL WITH NO READINT (I2) *)
READINT (I2) ;   (*THIS GOES INTO UCHKH WITH NO READINT (I1) *)
WRITEINT (I1) ;   (*THIS GOES INTO UCHKL WITH NO WRITEINT (I2) *)
WRITEINT (I2) ;   (*THIS GOES INTO UCHKH WITH NO WRITEINT (I1) *)

UCHKH, UCHKL :

    with STK[TOP] do
	begin
	if OPC := UCHKH then 
	    begin
	    if OPC_OLD <> UCHKL THEN I1 := MIN_ON_HOST else
		begin
		NEWINSTREC := NEWINSTREC_OLD;	(* To overwrite old data*)
		MAINCODE.NWORDS := NWORDS_OLD;
		end;
	    end else
	    begin
	    NEWINSTREC_OLD := NEWINSTREC;
	    NWORDS_OLD := MAINCODE.NWORDS;
	    I2 := MAXSIGNEDS1ADDR;
	    end;
	if not ((DTYPE in [TYPA,TYPB,TYPC,TYPN])
		or IS_INTEGER[DTYPE]) then
	    ERROR(WCHECKING_INVALID_TYPE);
	if DTYPE = TYPN then
	    if I1 < 0 then (*nil OK*)
	    else ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
	else if IS_CONSTANT(TOP) then
	    begin
	    if (ADDRORVAL.FPA.MEMADR.DSPLMT < I1) then
		    ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
	    end
	else
	    begin (*not constant*)
	    GET_OPERAND(OPND2,TOP);
	    if TYP = TYPA then
		begin (*Make sure address is on heap (or maybe nil)*)
		if DTYPE <> TYPA then
		    ERROR(WADDRESS_CHECK_ON_NONADDRESS);
		if I1 < 0 then
		    begin
		    SKIPLOC := NEWINSTREC;
		    IMM_OPERAND(OPND1,NILVAL);
		    EMITSOP(XSKP_EQL_S,0,OPND1,OPND2,nil)
		    end;
		REG_OPERAND(OPNDR,S1RNP);
		EMITXOP(XBTRP_B_S,OPNDR,OPND2);
		if I1 < 0 then
		    FIXSOP(SKIPLOC,NEWINSTREC)
		end (*TYPA*)
	    else
		begin (*not address check*)
		if (TYP=TYPJ) and ((I1=0) or (I1=1)) then
		    begin
		    (*The error trap handler will deduce that the CHK
		     was TYPJ by the fact that the BTRP_N was used.*)
		    S1OP := BTRP_N_X[I1,DTYPE];
		    IMM_OPERAND(OPND1,I2)
		    end
		else
		    begin
		    S1OP := BTRP_B_X[DTYPE];
		    EXTENDED_REGDISP_OPERAND(OPND1,S1RPC,0);
		    UPD_BOUNDTBL(OPND1.XW.DISP,I1,I2,TYP);
		    OPND1.FIXUP := BOUNDFIX
		    end;
		EMITXOP(S1OP,OPND1,OPND2)
		end (*not address check*)
	    end (*not constant*)
	end (*UCHK*);



UCHKF :
    while STK[TOP] do
	begin